Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/easyx/data1.cab/Example_Files/pong/Form1.frm

Visual Basic Form | 1998-11-03 | 19.4 KB | 544 lines

VERSION 5.00
Object = "{5A65A9C0-089F-11D2-88AD-0000B45C4CF6}#1.0#0"; "EASYX.OCX"
Begin VB.Form Form1
   Caption         =   "Pong"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer SetUpTimer
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   1800
      Top             =   1320
   End
   Begin PROJECTEXLibCtl.EasyX EasyX
      Left            =   960
      OleObjectBlob   =   "Form1.frx":014A
      Top             =   120
   End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'Characters
Dim FontSurface As Long
Dim Character(35) As Long
Const CharacterWidth As Long = 16
Const CharacterHeight As Long = 16
Const YTop As Long = 384 - 50
Const LevelX As Long = 10
Const PointX As Long = 10 + 12 * 16
Const BallsX As Long = 10 + 9 * 16 + 15 * 16
Dim CountDown As Long
Dim CurrentLevel As Long
Dim TotalPoint As Long
Dim CurrentBoulderHit As Long
Dim BallsLeft As Long
'sounds
Dim SoundWallHit As Long
Dim SoundBoulderHit As Long
Dim SoundPlateHit As Long
'ball
Dim BallSurface As Long
Dim Ball As Sprite
Const BallWidth As Long = 7
Const BallHeight As Long = 7
Dim BallMovePrLoop As Long
Dim BallEnglish As Long
'boulders
Dim BoulderSurface As Long
Dim Boulders(29) As Boulder
Const BoulderHeight As Long = 15
Const BoulderWidth As Long = 40
Dim BoulderSpace As Long
Dim YBoulderPosition As Long
'Screen coordinate
Const ScreenWidth As Long = 512
Const ScreenHeight As Long = 384
'keys
Dim KeyDirection As Long
Dim PreviousKey As Long
'plate variables
Dim PlateSurface As Long
Dim Plate(1) As Long
Dim PlateX As Long
Dim PlateY As Long
Const PlateWidth As Long = 50
Const PlateHeight As Long = 10
Const PlateMove As Long = 5
Private Sub SetSounds()
Dim AppPath As String
AppPath = App.Path & "\sounds\"
EasyX.InitializeSound
SoundWallHit = EasyX.CreateStaticSound(AppPath & "wallhit.wav")
SoundBoulderHit = EasyX.CreateStaticSound(AppPath & "boulderhit.wav")
SoundPlateHit = EasyX.CreateStaticSound(AppPath & "platehit.wav")
End Sub
Private Function BoulderHit(BoulderIndex As Long) As Boolean
Dim BallCenterX As Long, BallCenterY As Long
Dim BoulderCenterX As Long, BoulderCenterY As Long
If Boulders(BoulderIndex).Hit = True Then
    BoulderHit = False
    Exit Function
End If
BallCenterX = Ball.XPoint + (BallWidth \ 2)
BallCenterY = Ball.YPoint + (BallHeight \ 2)
BoulderCenterX = Boulders(BoulderIndex).XPoint + (BoulderWidth \ 2)
BoulderCenterY = Boulders(BoulderIndex).YPoint + (BoulderHeight \ 2)
BoulderHit = False
If Abs(BallCenterY - BoulderCenterY) < ((BallHeight + BoulderHeight) \ 2) Then
    If Abs(BallCenterX - BoulderCenterX) < ((BallWidth + BoulderWidth) \ 2) Then
        BoulderHit = True
    End If
End If
End Function
Private Sub CheckBoulderHit()
Dim I As Long
If Ball.YPoint > Boulders(UBound(Boulders)).YPoint + BoulderHeight Then
    Exit Sub
End If
For I = 0 To UBound(Boulders)
    If BoulderHit(I) = True And Not Boulders(I).Hit Then
        Boulders(I).Hit = True
        TotalPoint = TotalPoint + Boulders(I).Point
        EasyX.StopStaticSound SoundBoulderHit
        EasyX.PlayStaticSound SoundBoulderHit, 0
        Ball.YDirection = Ball.YDirection * -1
        CurrentBoulderHit = CurrentBoulderHit + 1
    End If
Next I
End Sub
Private Function CheckPlateHit() As Boolean
If Ball.YPoint + BallHeight < PlateY Then Exit Function
Dim BallCenterX As Long, BallCenterY As Long
Dim PlateCenterX As Long, PlateCenterY As Long
BallCenterX = Ball.XPoint + (BallWidth \ 2)
BallCenterY = Ball.YPoint + (BallHeight \ 2)
PlateCenterX = PlateX + (PlateWidth \ 2)
PlateCenterY = PlateY + (PlateHeight \ 2)
CheckPlateHit = False
If Abs(BallCenterY - PlateCenterY) < ((BallHeight + PlateHeight) \ 2) Then
    If Abs(BallCenterX - PlateCenterX) < ((BallWidth + PlateWidth) \ 2) Then
        EasyX.PlayStaticSound SoundPlateHit, 0
        CheckPlateHit = True
    End If
End If
End Function
Private Sub DrawBall()
'move it
Ball.XPoint = Ball.XPoint + BallMovePrLoop * Ball.XDirection
Ball.YPoint = Ball.YPoint + Ball.XSpeed * Ball.YDirection
'check wall hits
If Ball.XPoint + BallWidth > ScreenWidth Then
    Ball.XPoint = ScreenWidth - BallWidth
    EasyX.SetStaticPan SoundWallHit, EX_SOUNDRIGHT
    EasyX.PlayStaticSound SoundWallHit, 0
    Ball.XDirection = Ball.XDirection * -1
ElseIf Ball.XPoint < 0 Then
    Ball.XPoint = 0
    EasyX.SetStaticPan SoundWallHit, EX_SOUNDLEFT
    EasyX.PlayStaticSound SoundWallHit, 0
    Ball.XDirection = Ball.XDirection * -1
End If
If Ball.YPoint + BallHeight > ScreenHeight Then
    Ball.YPoint = ScreenHeight - BallHeight
    Ball.YDirection = Ball.YDirection * -1
ElseIf Ball.YPoint < 0 Then
    Ball.YPoint = 0
    EasyX.SetStaticPan SoundWallHit, EX_MIDDLE
    EasyX.PlayStaticSound SoundWallHit, 0
    Ball.YDirection = Ball.YDirection * -1
End If
EasyX.DrawSprite Ball.XPoint, Ball.YPoint, BallWidth, BallHeight, Ball.Number
End Sub
Private Sub DrawBoulders()
Dim I As Integer
For I = 0 To UBound(Boulders)
    If (Not Boulders(I).Hit) Then 'draw it
        EasyX.DrawSprite Boulders(I).XPoint, Boulders(I).YPoint, BoulderWidth, BoulderHeight, Boulders(I).Number
    End If
Next I
End Sub
Private Sub DrawPlate(PlateHit As Long)
Dim KeyLeft As Long, KeyRight As Long
'get the keys
KeyLeft = EasyX.GetKeyState(EX_LEFT)
If KeyLeft = EX_KEYBOARDLOST Then
    EasyX.AcquireKeyboard
End If
KeyRight = EasyX.GetKeyState(EX_RIGHT)
'move the plate
If KeyRight = EX_KEYDOWN And KeyLeft = EX_KEYDOWN Then 'both keys = no movement
    KeyDirection = 0
ElseIf KeyRight = EX_KEYDOWN Then
    KeyDirection = 1
    If BallEnglish < 0 Then BallEnglish = 0
    BallEnglish = BallEnglish + 1
ElseIf KeyLeft = EX_KEYDOWN Then
    KeyDirection = -1
    If BallEnglish > 0 Then BallEnglish = 0
    BallEnglish = BallEnglish - 1
    KeyDirection = 0
End If
PlateX = PlateX + PlateMove * KeyDirection
If PlateX < 0 Then PlateX = 0
If PlateX + PlateWidth > ScreenWidth Then PlateX = ScreenWidth - PlateWidth
EasyX.DrawSprite PlateX, PlateY, PlateWidth, PlateHeight, Plate(PlateHit)
End Sub
Private Sub Form_Load()
Dim rt As Long
Dim I As Long, J As Long
Dim AppPath As String
t forget this
EasyX.Window = Me.hWnd
'''''''''''''''''''''
AppPath = App.Path & "\images\"
rt = EasyX.InitDirectDraw(ScreenWidth, ScreenHeight, 8)
If rt <> EX_OK Then
    EasyX.EndDirectX
    MsgBox "Could not initialize direct draw", vbOKOnly, "Failure"
    Unload Me
    Exit Sub
End If
'create the keyboard
rt = EasyX.InitDirectInput()
If rt <> EX_OK Then
    EasyX.EndDirectX
    MsgBox "Could not create keyboard", vbOKOnly, "Failure"
    Unload Me
    Exit Sub
End If
'create the keyboard and mouse
EasyX.CreateKeyboard
EasyX.CreateMouse
'acquire the keyboard and mouse
EasyX.AcquireKeyboard
EasyX.AcquireMouse
'load the graphics
PlateSurface = EasyX.LoadBitmapFile(AppPath & "plate.bmp", -1)
If PlateSurface < 0 Then
    EasyX.EndDirectX
    MsgBox "Could not load graphic", vbOKOnly, "Failure"
    Unload Me
    Exit Sub
End If
BoulderSurface = EasyX.LoadBitmapFile(AppPath & "boulders.bmp", RGB(255, 255, 255))
If BoulderSurface < 0 Then
    EasyX.EndDirectX
    MsgBox "Could not load graphic", vbOKOnly, "Failure"
    Unload Me
    Exit Sub
End If
BallSurface = EasyX.LoadBitmapFile(AppPath & "ball.bmp", 0)
If BallSurface < 0 Then
    EasyX.EndDirectX
    MsgBox "Could not load graphic", vbOKOnly, "Failure"
    Unload Me
    Exit Sub
End If
FontSurface = EasyX.LoadBitmapFile(AppPath & "redfont.bmp", 0)
If FontSurface < 0 Then
    EasyX.EndDirectX
    MsgBox "Could not load graphic", vbOKOnly, "Failure"
    Unload Me
    Exit Sub
End If
''''''''''''''''
'make the plate
Plate(0) = EasyX.MakeSprite(0, 0, 50, 10, PlateSurface)
Plate(1) = EasyX.MakeSprite(0, 10, 50, 20, PlateSurface)
PlateX = ScreenWidth / 2 - PlateWidth / 2
PlateY = ScreenHeight - PlateHeight - 50
'make the boulders
'6 blue boulders
For I = 0 To 9
    Boulders(I).Number = EasyX.MakeSprite(0, 0, 40, 15, BoulderSurface)
    Boulders(I).Point = 2
Next I
'10 reds
For I = 10 To 19
    Boulders(I).Number = EasyX.MakeSprite(0, 15, 40, 30, BoulderSurface)
    Boulders(I).Point = 1
Next I
'2 of the rest
Boulders(20).Number = EasyX.MakeSprite(40, 0, 80, 15, BoulderSurface)
Boulders(20).Point = 3
Boulders(21).Number = EasyX.MakeSprite(40, 0, 80, 15, BoulderSurface)
Boulders(21).Point = 4
Boulders(22).Number = EasyX.MakeSprite(40, 15, 80, 30, BoulderSurface)
Boulders(22).Point = 5
Boulders(23).Number = EasyX.MakeSprite(40, 15, 80, 30, BoulderSurface)
Boulders(23).Point = 6
Boulders(24).Number = EasyX.MakeSprite(80, 0, 120, 15, BoulderSurface)
Boulders(24).Point = 7
Boulders(25).Number = EasyX.MakeSprite(80, 0, 120, 15, BoulderSurface)
Boulders(25).Point = 5
Boulders(26).Number = EasyX.MakeSprite(80, 15, 120, 30, BoulderSurface)
Boulders(26).Point = 8
Boulders(27).Number = EasyX.MakeSprite(80, 15, 120, 30, BoulderSurface)
Boulders(27).Point = 5
Boulders(28).Number = EasyX.MakeSprite(80, 15, 120, 30, BoulderSurface)
Boulders(28).Point = 3
Boulders(29).Number = EasyX.MakeSprite(80, 15, 120, 30, BoulderSurface)
Boulders(29).Point = 10
'Set the boulder positions
'the space between the boulders
CurrentLevel = 1
TotalPoint = 0
BallsLeft = 2
CurrentBoulderHit = 0
SetBoulders_Ball
'and the ball
Ball.Number = EasyX.MakeSprite(0, 0, BallWidth, BallHeight, BallSurface)
'set the characters
SetCharacters
'set text description
EasyX.SetText EX_PRIMARYSURFACE, 0, RGB(0, 255, 0), 16, "Verdana"
'set the sound
SetSounds
'Start the action
CountDown = 3
SetUpTimer.Enabled = True
End Sub
Private Sub SetBoulders_Ball()
Dim J As Long, I As Long
BoulderSpace = 10
YBoulderPosition = 10
For J = 1 To 3
    For I = 1 To 10
        Boulders(((J - 1) * 10) + I - 1).XPoint = BoulderSpace + ((I - 1) * (BoulderWidth + BoulderSpace))
        Boulders(((J - 1) * 10) + I - 1).YPoint = YBoulderPosition
        Boulders(((J - 1) * 10) + I - 1).Hit = False
    Next I
    'update y position
    YBoulderPosition = YBoulderPosition + BoulderHeight + BoulderSpace
Next J
'set the ball
s starting positions
Ball.XPoint = ScreenWidth / 2 - BallWidth / 2
Ball.YPoint = ScreenHeight / 2 - BallHeight * 2
'set the direction
Ball.XDirection = 1
Ball.YDirection = -1
'set the ball
s speed
BallMovePrLoop = 1 + CurrentLevel
Ball.XSpeed = 1 + CurrentLevel
End Sub
Private Sub RunMain()
    If EasyX.GetKeyState(EX_ESCAPE) = EX_KEYDOWN Then
        EasyX.EndDirectX
        Unload Me
        Exit Do
    End If
    'fill background with black
    EasyX.FillSurface 0, EX_PRIMARYSURFACE
    'draw the ball
    DrawBall
    'check boulder hits
    CheckBoulderHit
    If CurrentBoulderHit = 30 Then 'all hit
        EasyX.FillSurface 0, EX_PRIMARYSURFACE
        EasyX.FlipSurface
        RunNextLevel
        Exit Do
    End If
    'check plate hit
    If CheckPlateHit() Then
        DrawPlate 1

        If Abs(BallEnglish) > 0 Then
            If BallEnglish > 0 Then
                If Ball.XDirection > 0 Then
                    Ball.XSpeed = Ball.XSpeed + 1
                Else
                    Ball.XSpeed = Ball.XSpeed - 1
                    Ball.XDirection = Ball.XDirection * -1
                End If

            ElseIf BallEnglish < 0 Then
                If Ball.XDirection < 0 Then
                    Ball.XSpeed = Ball.XSpeed + 1
                Else
                    Ball.XSpeed = Ball.XSpeed - 1
                    Ball.XDirection = Ball.XDirection * -1
                End If
            End If

            If Ball.XSpeed < 1 Then Ball.XSpeed = 1
        End If

        Ball.YDirection = Ball.YDirection * -1
    Else
        DrawPlate 0

        If CheckPlateMiss() Then
            BallsLeft = BallsLeft - 1
                If BallsLeft < 0 Then 'finish
                    Runfinish
                    Exit Do
                End If
            EasyX.FillSurface 0, EX_PRIMARYSURFACE
            EasyX.FlipSurface
            RunReady
            Exit Do
        End If

    End If
    DrawBoulders
    'draw the text
    DrawText
    EasyX.FlipSurface
End Sub
Private Sub RunNextLevel()
CurrentLevel = CurrentLevel + 1
BallsLeft = BallsLeft + 1
SetBoulders_Ball
Ball.YDirection = -1
CountDown = 3
CurrentBoulderHit = 0
SetUpTimer.Enabled = True
End Sub
Private Function CheckPlateMiss() As Boolean
If Ball.YPoint - BallHeight / 2 > PlateY Then
    CheckPlateMiss = True
    CheckPlateMiss = False
End If
End Function
Private Sub Runfinish()
Const StartX As Long = 50
Const StartY As Long = 50
EasyX.FillSurface 0, EX_PRIMARYSURFACE
EasyX.DrawSprite StartX, StartY, CharacterWidth, CharacterHeight, Character(T)
EasyX.DrawSprite StartX + CharacterWidth * 1, StartY, CharacterWidth, CharacterHeight, Character(O)
EasyX.DrawSprite StartX + CharacterWidth * 2, StartY, CharacterWidth, CharacterHeight, Character(T)
EasyX.DrawSprite StartX + CharacterWidth * 3, StartY, CharacterWidth, CharacterHeight, Character(A)
EasyX.DrawSprite StartX + CharacterWidth * 4, StartY, CharacterWidth, CharacterHeight, Character(L)
EasyX.DrawSprite StartX + CharacterWidth * 6, StartY, CharacterWidth, CharacterHeight, Character(P)
EasyX.DrawSprite StartX + CharacterWidth * 7, StartY, CharacterWidth, CharacterHeight, Character(O)
EasyX.DrawSprite StartX + CharacterWidth * 8, StartY, CharacterWidth, CharacterHeight, Character(I)
EasyX.DrawSprite StartX + CharacterWidth * 9, StartY, CharacterWidth, CharacterHeight, Character(N)
EasyX.DrawSprite StartX + CharacterWidth * 10, StartY, CharacterWidth, CharacterHeight, Character(T)
EasyX.DrawSprite StartX + CharacterWidth * 11, StartY, CharacterWidth, CharacterHeight, Character(S)
DrawNumber TotalPoint, StartX + CharacterWidth * 13, StartY
EasyX.DrawSprite StartX, StartY * 2, CharacterWidth, CharacterHeight, Character(P)
EasyX.DrawSprite StartX + CharacterWidth * 1, StartY * 2, CharacterWidth, CharacterHeight, Character(L)
EasyX.DrawSprite StartX + CharacterWidth * 2, StartY * 2, CharacterWidth, CharacterHeight, Character(A)
EasyX.DrawSprite StartX + CharacterWidth * 3, StartY * 2, CharacterWidth, CharacterHeight, Character(Y)
EasyX.DrawSprite StartX + CharacterWidth * 5, StartY * 2, CharacterWidth, CharacterHeight, Character(A)
EasyX.DrawSprite StartX + CharacterWidth * 6, StartY * 2, CharacterWidth, CharacterHeight, Character(G)
EasyX.DrawSprite StartX + CharacterWidth * 7, StartY * 2, CharacterWidth, CharacterHeight, Character(A)
EasyX.DrawSprite StartX + CharacterWidth * 8, StartY * 2, CharacterWidth, CharacterHeight, Character(I)
EasyX.DrawSprite StartX + CharacterWidth * 9, StartY * 2, CharacterWidth, CharacterHeight, Character(N)
EasyX.FlipSurface
    If EasyX.GetKeyState(EX_Y) = EX_KEYDOWN Then
        SetStart
        Exit Do
    ElseIf EasyX.GetKeyState(EX_N) = EX_KEYDOWN Then
        EasyX.EndDirectX
        Unload Me
        Exit Do
    End If
End Sub
Private Sub SetStart()
CurrentLevel = 1
BallsLeft = 3
TotalPoint = 0
SetBoulders_Ball
Ball.YDirection = -1
CountDown = 3
CurrentBoulderHit = 0
SetUpTimer.Enabled = True
End Sub
Private Sub SetUpTimer_Timer()
EasyX.FillSurface 0, EX_PRIMARYSURFACE
EasyX.PrintText EX_PRIMARYSURFACE, "Get ready: " & Str(CountDown), (ScreenWidth / 2 - (Len("Get ready:  ") * 5)), ScreenHeight / 2 - 8, 100, 20
EasyX.FlipSurface
If CountDown = 0 Then
    SetUpTimer.Enabled = False
    CountDown = 3
    RunMain
End If
CountDown = CountDown - 1
End Sub
Private Sub SetCharacters()
Dim I As Long, J As Long
For J = 1 To 2
    For I = 1 To 18
        Character(((J - 1) * 18) + I - 1) = EasyX.MakeSprite((I - 1) * 16, (J - 1) * 16, _
                                                            I * 16, J * 16, FontSurface)
    Next I
Next J
End Sub
Private Sub DrawText()
EasyX.DrawSprite LevelX, YTop, CharacterWidth, CharacterHeight, Character(L)
EasyX.DrawSprite LevelX + 16, YTop, CharacterWidth, CharacterHeight, Character(E)
EasyX.DrawSprite LevelX + 32, YTop, CharacterWidth, CharacterHeight, Character(V)
EasyX.DrawSprite LevelX + 48, YTop, CharacterWidth, CharacterHeight, Character(E)
EasyX.DrawSprite LevelX + 64, YTop, CharacterWidth, CharacterHeight, Character(L)
DrawNumber CurrentLevel, LevelX + 84, YTop
EasyX.DrawSprite PointX, YTop, CharacterWidth, CharacterHeight, Character(P)
EasyX.DrawSprite PointX + 16, YTop, CharacterWidth, CharacterHeight, Character(O)
EasyX.DrawSprite PointX + 32, YTop, CharacterWidth, CharacterHeight, Character(I)
EasyX.DrawSprite PointX + 48, YTop, CharacterWidth, CharacterHeight, Character(N)
EasyX.DrawSprite PointX + 64, YTop, CharacterWidth, CharacterHeight, Character(T)
DrawNumber TotalPoint, PointX + 90, YTop
EasyX.DrawSprite BallsX, YTop, CharacterWidth, CharacterHeight, Character(L)
EasyX.DrawSprite BallsX + 16, YTop, CharacterWidth, CharacterHeight, Character(I)
EasyX.DrawSprite BallsX + 32, YTop, CharacterWidth, CharacterHeight, Character(V)
EasyX.DrawSprite BallsX + 48, YTop, CharacterWidth, CharacterHeight, Character(E)
EasyX.DrawSprite BallsX + 64, YTop, CharacterWidth, CharacterHeight, Character(S)
DrawNumber BallsLeft, BallsX + 84, YTop
End Sub
Private Sub DrawNumber(Number As Long, X As Long, Y As Long)
Dim I As Long
Dim TempString As String
Dim StringNumber As String
StringNumber = CStr(Number)
I = 1
Do While Len(StringNumber) > 0
    TempString = Mid(StringNumber, I, 1)
    StringNumber = Right(StringNumber, Len(StringNumber) - 1)
    Select Case TempString
        Case "1"
            EasyX.DrawSprite X, Y, CharacterWidth, CharacterHeight, Character(One)
        Case "2"
            EasyX.DrawSprite X, Y, CharacterWidth, CharacterHeight, Character(Two)
        Case "3"
            EasyX.DrawSprite X, Y, CharacterWidth, CharacterHeight, Character(Three)
        Case "4"
            EasyX.DrawSprite X, Y, CharacterWidth, CharacterHeight, Character(Four)
        Case "5"
            EasyX.DrawSprite X, Y, CharacterWidth, CharacterHeight, Character(Five)
        Case "6"
            EasyX.DrawSprite X, Y, CharacterWidth, CharacterHeight, Character(Six)
        Case "7"
            EasyX.DrawSprite X, Y, CharacterWidth, CharacterHeight, Character(Seven)
        Case "8"
            EasyX.DrawSprite X, Y, CharacterWidth, CharacterHeight, Character(Eight)
        Case "9"
            EasyX.DrawSprite X, Y, CharacterWidth, CharacterHeight, Character(Nine)
        Case 0
            EasyX.DrawSprite X, Y, CharacterWidth, CharacterHeight, Character(Zero)

    End Select
    X = X + CharacterWidth

Exit Sub
End Sub
Private Sub RunReady()
Ball.YPoint = ScreenHeight / 2 - BallHeight * 2
Ball.XPoint = ScreenWidth / 2 - BallWidth / 2
Ball.YDirection = -1
Ball.XSpeed = CurrentLevel
SetUpTimer.Enabled = True
End Sub